perm filename TANGLE.POS[WEB,ALS] blob
sn#628252 filedate 1981-12-16 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00008 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 {2}{4}{$C-,A+,D-}{[$C+,D+]}
C00006 00003 {23}{PROCEDURE DEBUGHELP
C00024 00004 {64}PROCEDURE Storetwobyte(x:sixteenbits)
C00040 00005 {96}PROCEDURE Sendsign(v:integer)
C00051 00006 {114}PROCEDURE Getline
C00065 00007 {139}PROCEDURE Scanrepl(t:eightbits)
C00076 00008 {155}BEGIN
C00079 ENDMK
C⊗;
{2}{4}{$C-,A+,D-}{[$C+,D+]}
PROGRAM Tangle(input,output,pool,tty);
LABEL 9999;
CONST
{7}bufsize=100;
maxbytes=30000;
maxtoks=65535;
maxnames=4000;
maxtexts=2000;
hashsize=353;
longestname=300;
linelength=72;
outbufsize=144;
stacksize=50;
maxidlength=12;
unambiglengt=7;
TYPE
{8}asciicode=0..127;
{30}eightbits=0..255;
sixteenbits=0..65535;
{32}namepointer=0..maxnames;
{35}textpointer=0..maxtexts;
{69}outputstate=RECORD endfield:sixteenbits;
bytefield:sixteenbits;
namefield:namepointer;
replfield:textpointer;
END;
VAR
{10}xord:ARRAY[char]OF asciicode;
xchr:ARRAY[asciicode]OF char;
{18}pool:FILE OF char;
{20}buffer:ARRAY[0..bufsize]OF asciicode;
{22}phaseone:boolean;
{31}bytemem:PACKED ARRAY[0..maxbytes]OF asciicode;
tokmem:PACKED ARRAY[0..maxtoks]OF eightbits;
bytestart:ARRAY[0..maxnames]OF sixteenbits;
tokstart:ARRAY[0..maxtexts]OF sixteenbits;
link:ARRAY[0..maxnames]OF sixteenbits;
ilk:ARRAY[0..maxnames]OF sixteenbits;
equiv:ARRAY[0..maxnames]OF sixteenbits;
textlink:ARRAY[0..maxtexts]OF sixteenbits;
{33}nameptr:namepointer;
stringptr:namepointer;
byteptr:0..maxbytes;
{36}textptr:textpointer;
tokptr:0..maxtoks;
{MAXTOKPTR:0..MAXTOKS;}{41}idfirst:0..bufsize;
idloc:0..bufsize;
doublechars:0..bufsize;
hash,chophash:ARRAY[0..hashsize]OF sixteenbits;
choppedid:ARRAY[0..unambiglengt]OF asciicode;
{56}module:ARRAY[0..longestname]OF asciicode;
{61}lastunnamed:textpointer;
{70}curstate:outputstate;
stack:ARRAY[1..stacksize]OF outputstate;
stackptr:0..stacksize;
{72}bracelevel:eightbits;
{76}curval:integer;
{84}outbuf:ARRAY[0..outbufsize]OF asciicode;
outptr:0..outbufsize;
breakptr:0..outbufsize;
semiptr:0..outbufsize;
{85}outstate:eightbits;
outval,outapp:integer;
outsign:asciicode;
{90}outcontrib:ARRAY[1..linelength]OF asciicode;
{112}page:sixteenbits;
line:sixteenbits;
limit:0..bufsize;
loc:0..bufsize;
inputhasende:boolean;
{120}curmodule:namepointer;
{131}nextcontrol:eightbits;
{138}currepltext:textpointer;
{144}modulecount:0..12287;
{152}{TROUBLESHOOT:BOOLEAN;
DDT:SIXTEENBITS;
DD:SIXTEENBITS;
DEBUGCYCLE:INTEGER;
DEBUGSKIPPED:INTEGER;}
{23}{PROCEDURE DEBUGHELP;
FORWARD;}
{24}
PROCEDURE Error;
VAR
j:0..outbufsize;
k,l:0..bufsize;
BEGIN
IF phaseone THEN
{25}
BEGIN
Writeln(tty,'. (p.',page:0,',l.',line:0,
')');
IF loc>=limit THEN
l:=limit
ELSE
l:=loc;
FOR k:=1 TO l DO
IF buffer[k-1]=9 THEN Write(tty,' ')
ELSE Write(tty,xchr[buffer[k-1]]);
Writeln(tty);
FOR k:=1 TO l DO Write(tty,' ');
FOR k:=l+1 TO limit DO Write(tty,xchr[buffer[k-1]]);
Write(tty,' ');
END
ELSE
{26}
BEGIN
Writeln(tty,'. (l.',line:0,')');
FOR j:=1 TO outptr DO Write(tty,xchr[outbuf[j-1]]);
Write(tty,'...');
END;
{DEBUGHELP;}
END;
{27}
PROCEDURE Quit;
BEGIN
GOTO 9999;
END;
PROCEDURE Initialize;
VAR
{9}i:0..127;
{42}h:0..hashsize;
BEGIN{11}
xchr[32]:=' '; xchr[33]:='!'; xchr[34]:='"'; xchr[35]:='#';
xchr[36]:='$'; xchr[37]:='%'; xchr[38]:='&'; xchr[39]:='''';
xchr[40]:='('; xchr[41]:=')'; xchr[42]:='*'; xchr[43]:='+';
xchr[44]:=','; xchr[45]:='-'; xchr[46]:='.'; xchr[47]:='/';
xchr[48]:='0'; xchr[49]:='1'; xchr[50]:='2'; xchr[51]:='3';
xchr[52]:='4'; xchr[53]:='5'; xchr[54]:='6'; xchr[55]:='7';
xchr[56]:='8'; xchr[57]:='9'; xchr[58]:=':'; xchr[59]:=';';
xchr[60]:='<'; xchr[61]:='='; xchr[62]:='>'; xchr[63]:='?';
xchr[64]:='@'; xchr[65]:='A'; xchr[66]:='B'; xchr[67]:='C';
xchr[68]:='D'; xchr[69]:='E'; xchr[70]:='F'; xchr[71]:='G';
xchr[72]:='H'; xchr[73]:='I'; xchr[74]:='J'; xchr[75]:='K';
xchr[76]:='L'; xchr[77]:='M'; xchr[78]:='N'; xchr[79]:='O';
xchr[80]:='P'; xchr[81]:='Q'; xchr[82]:='R'; xchr[83]:='S';
xchr[84]:='T'; xchr[85]:='U'; xchr[86]:='V'; xchr[87]:='W';
xchr[88]:='X'; xchr[89]:='Y'; xchr[90]:='Z'; xchr[91]:='[';
xchr[92]:='\'; xchr[93]:=']'; xchr[94]:='↑'; xchr[95]:='←';
xchr[96]:='`'; xchr[97]:='a'; xchr[98]:='b'; xchr[99]:='c';
xchr[100]:='d'; xchr[101]:='e'; xchr[102]:='f'; xchr[103]:='g';
xchr[104]:='h'; xchr[105]:='i'; xchr[106]:='j'; xchr[107]:='k';
xchr[108]:='l'; xchr[109]:='m'; xchr[110]:='n'; xchr[111]:='o';
xchr[112]:='p'; xchr[113]:='q'; xchr[114]:='r'; xchr[115]:='s';
xchr[116]:='t'; xchr[117]:='u'; xchr[118]:='v'; xchr[119]:='w';
xchr[120]:='x'; xchr[121]:='y'; xchr[122]:='z'; xchr[123]:='{';
xchr[124]:='|'; xchr[125]:='}'; xchr[126]:='~'; xchr[0]:=' ';
xchr[127]:=' ';
{13}FOR i:=1 TO 31 DO xchr[i]:=Chr(i);
xchr[24]:=Chr(95);
xchr[26]:=Chr(27);
xchr[27]:=Chr(126);
{14}
FOR i:=0 TO 127 DO xord[Chr(i)]:=32;
FOR i:=1 TO 126 DO xord[xchr[i]]:=i;
{19}Rewrite(pool);
{34}nameptr:=1;
stringptr:=128;
byteptr:=1;
bytestart[0]:=1;
bytestart[1]:=1;
{37}tokptr:=1;
textptr:=1;
tokstart[0]:=1;
tokstart[1]:=1;
{39}ilk[0]:=0;
equiv[0]:=0;
{43}
FOR h:=0 TO hashsize-1 DO
BEGIN
hash[h]:=0;
chophash[h]:=0;
END;
{62}lastunnamed:=0;
textlink[0]:=0;
{127}module[0]:=32;
{153}{TROUBLESHOOT:=TRUE;DEBUGCYCLE:=1;DEBUGSKIPPED:=0;
TROUBLESHOOT:=FALSE;DEBUGCYCLE:=99999;}
END;
{17}
PROCEDURE Openinput;
BEGIN
Reset(input,'','/E');
END;
{21}
FUNCTION Inputln:boolean;
LABEL
30;
BEGIN
IF Eof(input)THEN
Inputln:=false
ELSE
BEGIN
limit:=0;
buffer[0]:=xord[input↑];
IF buffer[0]=12 THEN
Readln
ELSE
WHILE true DO
BEGIN
IF Eoln(input)AND(
input↑<>Chr(26))AND(input↑<>Chr(27))THEN
BEGIN
buffer[limit]:=13;
Readln;
GOTO 30;
END;
IF limit=bufsize-1 THEN
BEGIN
buffer[limit]:=13;
BEGIN
Writeln(tty);
Write(tty,'! Input line too long');
END;
Error;
GOTO 30;
END;
limit:=limit+1;
Get(input);
IF Eof(input)THEN
BEGIN
buffer[limit]:=13;
GOTO 30;
END;
buffer[limit]:=xord[input↑];
END;
30:
Inputln:=true;
END;
END;
{40}
PROCEDURE Printid(p:namepointer);
VAR
k:0..maxbytes;
BEGIN
IF p>=nameptr THEN
Write(tty,'IMPOSSIBLE')
ELSE
FOR k:=bytestart[p]
TO bytestart[p+1]-1 DO Write(tty,xchr[bytemem[k]]);
END;
{44}
FUNCTION Idlookup(t:eightbits):namepointer;
LABEL
31,32;
VAR
c:eightbits;
i:0..bufsize;
h:0..hashsize;
k:0..maxbytes;
l:0..bufsize;
p,q:namepointer;
s:0..unambiglengt;
BEGIN
l:=idloc-idfirst;
{45}h:=buffer[idfirst];
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
h:=(h+h+buffer[i])MOD hashsize;
i:=i+1;
END;
{46}p:=hash[h];
WHILE p<>0 DO
BEGIN
IF bytestart[p+1]-bytestart[p]=l THEN
{47}
BEGIN
i:=
idfirst;
k:=bytestart[p];
WHILE(i<idloc)AND(buffer[i]=bytemem[k])DO
BEGIN
i:=i+1;
k:=k+1;
END;
IF i=idloc THEN
GOTO 31;
END;
p:=link[p];
END;
p:=nameptr;
link[p]:=hash[h];
hash[h]:=p;
31:;
IF(p=nameptr)OR(t<>0)THEN
{48}
BEGIN
IF((p<>nameptr)AND(t<>0)AND(ilk[p]=0)
)OR((p=nameptr)AND(t=0)AND(buffer[idfirst]<>34))THEN
{49}
BEGIN
i:=idfirst
;
s:=0;
h:=0;
WHILE(i<idloc)AND(s<unambiglengt)DO
BEGIN
IF buffer[i]<>95 THEN
BEGIN
IF
buffer[i]>=97 THEN
choppedid[s]:=buffer[i]-32
ELSE
choppedid[s]:=buffer[
i];
h:=(h+h+choppedid[s])MOD hashsize;
s:=s+1;
END;
i:=i+1;
END;
choppedid[s]:=0;
END;
IF p<>nameptr THEN
{50}
BEGIN
IF ilk[p]=0 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! This identifier has already appeared');
Error;
END;
{51}q:=chophash[h];
IF q=p THEN
chophash[h]:=equiv[p]
ELSE
BEGIN
WHILE equiv[q]<>p DO q:=
equiv[q];
equiv[q]:=equiv[p];
END;
END
ELSE
BEGIN
Writeln(tty);
Write(tty,'! This identifier was defined before');
Error;
END;
ilk[p]:=t;
END
ELSE
{52}
BEGIN
IF(t=0)AND(buffer[idfirst]<>34)THEN
{53}
BEGIN
q:=
chophash[h];
WHILE q<>0 DO
BEGIN{54}
BEGIN
k:=bytestart[q];
s:=0;
WHILE(k<bytestart[q+1])AND(s<unambiglengt)DO
BEGIN
c:=bytemem[k];
IF c<>95 THEN
BEGIN
IF c>=97 THEN
c:=c-32;
IF choppedid[s]<>c THEN
GOTO 32;
s:=s+1;
END;
k:=k+1;
END;
IF(k=bytestart[q+1])AND(choppedid[s]<>0)THEN
GOTO 32;
BEGIN
Writeln(tty);
Write(tty,'! Identifier conflict with ');
END;
FOR k:=bytestart[q]TO bytestart[q+1]-1 DO Write(tty,xchr[bytemem[k]]);
Error;
q:=0;
32:
END;
q:=equiv[q];
END;
equiv[p]:=chophash[h];
chophash[h]:=p;
END;
IF byteptr+l>maxbytes THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
i:=idfirst;
k:=byteptr;
WHILE i<idloc DO
BEGIN
bytemem[k]:=buffer[i];
k:=k+1;
i:=i+1;
END;
byteptr:=k;
nameptr:=nameptr+1;
bytestart[nameptr]:=k;
IF buffer[idfirst]<>34 THEN
ilk[p]:=t
ELSE
{55}
BEGIN
ilk[p]:=1;
IF l-doublechars=2 THEN
equiv[p]:=buffer[idfirst+1]+32768
ELSE
BEGIN
equiv[p]:=stringptr+32768;
l:=l-doublechars-1;
IF l>99 THEN
BEGIN
Writeln(tty);
Write(tty,'! Preprocessed string is too long');
Error;
END;
stringptr:=stringptr+1;
Write(pool,xchr[48+l DIV 10],xchr[48+l MOD 10]);
i:=idfirst+1;
WHILE i<idloc DO
BEGIN
Write(pool,xchr[buffer[i]]);
IF(buffer[i]=34)OR(buffer[i]=64)THEN
i:=i+2
ELSE
i:=i+1;
END;
END;
END;
END;
END;
Idlookup:=p;
END;
{57}
FUNCTION Modlookup(l:sixteenbits):namepointer;
LABEL
31;
VAR
c:(less,equal,greater,prefix,extension);
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
BEGIN
c:=greater;
q:=0;
p:=ilk[0];
WHILE p<>0 DO
BEGIN{59}
BEGIN
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1
;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN
c:=equal
ELSE
c:=extension
ELSE
IF j
>l THEN
c:=prefix
ELSE
IF module[j]<bytemem[k]THEN
c:=less
ELSE
c:=
greater;
END;
q:=p;
IF c=less THEN
p:=link[q]
ELSE
IF c=greater THEN
p:=ilk[q]
ELSE
GOTO 31;
END;
{58}
IF byteptr+l>maxbytes THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','byte memory',' capacity exceeded');
Error;
Quit;
END;
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
p:=nameptr;
IF c=less THEN
link[q]:=p
ELSE
ilk[q]:=p;
link[p]:=0;
ilk[p]:=0;
c:=equal;
equiv[p]:=0;
FOR j:=1 TO l DO bytemem[byteptr+j-1]:=module[j];
byteptr:=byteptr+l;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;
;
31:
IF c<>equal THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Incompatible module names');
Error;
END;
p:=0;
END;
Modlookup:=p;
END;
{60}
FUNCTION Prefixlookup(l:sixteenbits):namepointer;
LABEL
31;
VAR
c:(less,equal,greater,prefix,extension);
count:0..maxnames;
j:0..longestname;
k:0..maxbytes;
p:namepointer;
q:namepointer;
r:namepointer;
BEGIN
q:=0;
p:=ilk[0];
count:=0;
r:=0;
WHILE p<>0 DO
BEGIN{59}
BEGIN
k:=bytestart[p];
c:=equal;
j:=1;
WHILE(k<bytestart[p+1])AND(j<=l)AND(module[j]=bytemem[k])DO
BEGIN
k:=k+1
;
j:=j+1;
END;
IF k=bytestart[p+1]THEN
IF j>l THEN
c:=equal
ELSE
c:=extension
ELSE
IF j
>l THEN
c:=prefix
ELSE
IF module[j]<bytemem[k]THEN
c:=less
ELSE
c:=
greater;
END;
IF c=less THEN
p:=link[p]
ELSE
IF c=greater THEN
p:=ilk[p]
ELSE
BEGIN
r:=p
;
count:=count+1;
q:=ilk[p];
p:=link[p];
END;
IF p=0 THEN
BEGIN
p:=q;
q:=0;
END;
END;
IF count<>1 THEN
IF count=0 THEN
BEGIN
Writeln(tty);
Write(tty,'! Name does not match');
Error;
END
ELSE
BEGIN
Writeln(tty);
Write(tty,'! Ambiguous prefix');
Error;
END;
Prefixlookup:=r;
END;
{64}PROCEDURE Storetwobyte(x:sixteenbits);
BEGIN
IF tokptr+2>maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=x DIV 256;
tokmem[tokptr+1]:=x MOD 256;
tokptr:=tokptr+2;
END;
{65}{PROCEDURE PRINTREPL(P:TEXTPOINTER);
VAR
K:0..MAXTOKS;
A:SIXTEENBITS;
BEGIN
IF P>=TEXTPTR THEN WRITE(TTY,'BAD')
ELSE
BEGIN
K:=TOKSTART[P];
WHILE K<TOKSTART[P+1]DO
BEGIN
A:=TOKMEM[K];
IF A>=128 THEN[66]
BEGIN
K:=K+1;
IF A<168 THEN
BEGIN
A:=(A-128)*256+TOKMEM[K];
PRINTID(A);
IF BYTEMEM[BYTESTART[A]]=34 THEN WRITE(TTY,'"')
ELSE WRITE(TTY,' ');
END
ELSE IF A<208 THEN
BEGIN
WRITE(TTY,'@<');
PRINTID((A-168)*256+TOKMEM[K]);
WRITE(TTY,'@>');
END
ELSE
BEGIN
A:=(A-208)*256+TOKMEM[K];
WRITE(TTY,'@{',A:0,'@',XCHR[125]);
END;
END
ELSE
[67]CASE A OF
9:WRITE(TTY,'@{');
10:WRITE(TTY,'@',XCHR[125]);
12:WRITE(TTY,'@''');
13:WRITE(TTY,'#');
64:WRITE(TTY,'@@');
OTHERS:WRITE(TTY,XCHR[A])
END;
K:=K+1;
END;
END;
END;}
{74}PROCEDURE Pushlevel(p:namepointer);
BEGIN
IF stackptr=stacksize THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','stack',' capacity exceeded');
Error;
Quit;
END
ELSE
BEGIN
stack[stackptr]:=curstate;
stackptr:=stackptr+1;
curstate.namefield:=p;
curstate.replfield:=equiv[p];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
END;
END;
{75}
PROCEDURE Poplevel;
LABEL
10;
BEGIN
IF textlink[curstate.replfield]=0 THEN
BEGIN
IF ilk[curstate.
namefield]=3 THEN
{81}
BEGIN{IF TOKPTR>MAXTOKPTR THEN MAXTOKPTR:=TOKPTR;
}
nameptr:=nameptr-1;
textptr:=textptr-1;
tokptr:=tokstart[textptr];
{BYTEPTR:=BYTEPTR-1;}
END;
END
ELSE
IF textlink[curstate.replfield]<maxtexts THEN
BEGIN
curstate.
replfield:=textlink[curstate.replfield];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
GOTO 10;
END;
stackptr:=stackptr-1;
IF stackptr>0 THEN
curstate:=stack[stackptr];
10:
END;
{77}
FUNCTION Getoutput:sixteenbits;
LABEL
20,30;
VAR
a:sixteenbits;
b:eightbits;
bal:sixteenbits;
BEGIN
20:
IF stackptr=0 THEN
a:=0
ELSE
BEGIN
IF curstate.bytefield=
curstate.endfield THEN
BEGIN
Poplevel;
GOTO 20;
END;
a:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF a<128 THEN
BEGIN
IF a=13 THEN
{82}
BEGIN
Pushlevel(nameptr-1);
GOTO 20;
END;
END
ELSE
BEGIN
a:=(a-128)*256+tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF a<10240 THEN
{79}
BEGIN
CASE ilk[a]OF
0:BEGIN
curval:=a;
a:=130;
END;
1:BEGIN
curval:=equiv[a]-32768;
a:=128;
END;
2:BEGIN
Pushlevel(a);
GOTO 20;
END;
3:BEGIN{80}
WHILE(curstate.bytefield=curstate.endfield)AND(stackptr>0)DO
Poplevel;
IF(stackptr=0)OR(tokmem[curstate.bytefield]<>40)THEN
BEGIN
BEGIN
Writeln
(tty);
Write(tty,'! No parameter given for ');
END;
Printid(a);
Error;
GOTO 20;
END;
{83}bal:=1;
curstate.bytefield:=curstate.bytefield+1;
WHILE true DO
BEGIN
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
IF b=13 THEN
Storetwobyte(nameptr+32767)
ELSE
BEGIN
IF b>=128 THEN
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
END
ELSE
CASE b OF
40:bal:=bal+1;
41:BEGIN
bal:=bal-1;
IF bal=0 THEN
GOTO 30;
END;
39:REPEAT
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
b:=tokmem[curstate.bytefield];
curstate.bytefield:=curstate.bytefield+1;
UNTIL b=39;
OTHERS:
END;
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
END;
END;
30:;
equiv[nameptr]:=textptr;
ilk[nameptr]:=2;
{IF BYTEPTR=MAXBYTES THEN BEGIN WRITELN(TTY);
WRITE(TTY,'! Sorry, ','byte memory',' capacity exceeded');ERROR;QUIT;
END;BYTEMEM[BYTEPTR]:=35;BYTEPTR:=BYTEPTR+1;
}
IF nameptr=maxnames THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','name',' capacity exceeded');
Error;
Quit;
END;
nameptr:=nameptr+1;
bytestart[nameptr]:=byteptr;
IF textptr=maxtexts THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','text',' capacity exceeded');
Error;
Quit;
END;
textlink[textptr]:=0;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
;
Pushlevel(a);
GOTO 20;
END;
OTHERS:BEGIN
Writeln(tty);
Write(tty,'! This can''t happen (','output',')');
Error;
Quit;
END
END
END
ELSE
IF a<20480 THEN
{78}
BEGIN
a:=a-10240;
IF equiv[a]<>0 THEN
Pushlevel(a)
ELSE
IF a<>0 THEN
BEGIN
BEGIN
Writeln(
tty);
Write(tty,'! Not present: <');
END;
Printid(a);
Write(tty,'>');
Error;
END;
GOTO 20;
END
ELSE
BEGIN
curval:=a-20480;
a:=129;
END;
END;
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}Getoutput:=a;
END;
{87}
PROCEDURE Flushbuffer;
VAR
k:0..outbufsize;
b:0..outbufsize;
BEGIN
b:=breakptr;
IF(semiptr<>0)AND(outptr-semiptr<=linelength)THEN
breakptr:=semiptr;
FOR k:=1 TO breakptr DO Write(xchr[outbuf[k-1]]);
Writeln;
line:=line+1;
IF line MOD 100=0 THEN
Write(tty,'.');
IF breakptr<outptr THEN
BEGIN
IF outbuf[breakptr]=32 THEN
BEGIN
breakptr
:=breakptr+1;
IF breakptr>b THEN
b:=breakptr;
END;
FOR k:=breakptr TO outptr-1 DO outbuf[k-breakptr]:=outbuf[k];
END;
outptr:=outptr-breakptr;
breakptr:=b-breakptr;
semiptr:=0;
IF outptr>linelength THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Long line must be truncated');
Error;
END;
outptr:=linelength;
END;
END;
{89}
PROCEDURE Appval(v:integer);
VAR
k:0..outbufsize;
BEGIN
k:=outbufsize;
REPEAT
outbuf[k]:=v MOD 10;
v:=v DIV 10;
k:=k-1;
UNTIL v=0;
REPEAT
k:=k+1;
BEGIN
outbuf[outptr]:=outbuf[k]+48;
outptr:=outptr+1;
END;
UNTIL k=outbufsize;
END;
{91}
PROCEDURE Sendout(t:eightbits;v:sixteenbits);
LABEL
20;
VAR
k:0..linelength;
BEGIN{92}
20:
CASE outstate OF
1:IF t<>3 THEN
BEGIN
breakptr:=outptr;
IF t=2 THEN
BEGIN
outbuf[outptr]:=32;
outptr:=outptr+1;
END;
END;
2:BEGIN
BEGIN
outbuf[outptr]:=44-outapp;
outptr:=outptr+1;
END;
IF outptr>linelength THEN
Flushbuffer;
breakptr:=outptr;
END;
3,4:BEGIN{93}
IF outval<0 THEN
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END
ELSE
IF outsign>0 THEN
BEGIN
outbuf[outptr]:=outsign;
outptr:=outptr+1;
END;
Appval(Abs(outval));
IF outptr>linelength THEN
Flushbuffer;
;
outstate:=outstate-2;
GOTO 20;
END;
5:{94}BEGIN
IF(t=3)OR({95}((t=2)AND(v=3)AND(((outcontrib[1]=68)AND(
outcontrib[2]=73)AND(outcontrib[3]=86))OR((outcontrib[1]=77)AND(
outcontrib[2]=79)AND(outcontrib[3]=68))))OR((t=0)AND((v=42)OR(v=47))))
THEN
BEGIN{93}
IF outval<0 THEN
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END
ELSE
IF outsign>0 THEN
BEGIN
outbuf[outptr]:=outsign;
outptr:=outptr+1;
END;
Appval(Abs(outval));
IF outptr>linelength THEN
Flushbuffer;
;
outsign:=43;
outval:=outapp;
END
ELSE
outval:=outval+outapp;
outstate:=3;
GOTO 20;
END;
0:IF t<>3 THEN
breakptr:=outptr;
OTHERS:
END;
IF t<>0 THEN
FOR k:=1 TO v DO
BEGIN
outbuf[outptr]:=outcontrib[k];
outptr:=outptr+1;
END
ELSE
BEGIN
outbuf[outptr]:=v;
outptr:=outptr+1;
END;
IF outptr>linelength THEN
Flushbuffer;
IF(t=0)AND(v=59)THEN
BEGIN
semiptr:=outptr;
breakptr:=outptr;
END;
IF t>=2 THEN
outstate:=1
ELSE
outstate:=0
END;
{96}PROCEDURE Sendsign(v:integer);
BEGIN
CASE outstate OF
2,4:outapp:=outapp*v;
3:BEGIN
outapp:=v;
outstate:=4;
END;
5:BEGIN
outval:=outval+outapp;
outapp:=v;
outstate:=4;
END;
OTHERS:BEGIN
breakptr:=outptr;
outapp:=v;
outstate:=2;
END
END;
END;
{97}
PROCEDURE Sendval(v:integer);
LABEL
666,10;
BEGIN
CASE outstate OF
1:BEGIN{100}
IF(outptr=breakptr+3)OR((outptr=breakptr+4)
AND(outbuf[breakptr]=32))THEN
IF((outbuf[outptr-3]=68)AND(outbuf[outptr-2]=73)
AND(outbuf[outptr-1]=86))OR((outbuf[outptr-3]=77)
AND(outbuf[outptr-2]=79)AND(outbuf[outptr-1]=68))THEN
GOTO 666;
outsign:=32;
outstate:=3;
outval:=v;
breakptr:=outptr;
END;
0:BEGIN{99}
IF(outptr=breakptr+1)AND((outbuf[breakptr]=42)OR(outbuf[
breakptr]=47))THEN
GOTO 666;
outsign:=0;
outstate:=3;
outval:=v;
breakptr:=outptr;
END;
{98}2:BEGIN
outsign:=43;
outstate:=3;
outval:=outapp*v;
END;
3:BEGIN
outstate:=5;
outapp:=v;
END;
4:BEGIN
outstate:=5;
outapp:=outapp*v;
END;
5:BEGIN
outval:=outval+outapp;
outapp:=v;
END;
OTHERS:GOTO 666
END;
GOTO 10;
666:{101}
IF v>=0 THEN
BEGIN
IF outstate=1 THEN
BEGIN
breakptr:=outptr;
BEGIN
outbuf[outptr]:=32;
outptr:=outptr+1;
END;
END;
Appval(v);
IF outptr>linelength THEN
Flushbuffer;
outstate:=1;
END
ELSE
BEGIN
BEGIN
outbuf[outptr]:=40;
outptr:=outptr+1;
END;
BEGIN
outbuf[outptr]:=45;
outptr:=outptr+1;
END;
Appval(-v);
BEGIN
outbuf[outptr]:=41;
outptr:=outptr+1;
END;
IF outptr>linelength THEN
Flushbuffer;
outstate:=0;
END;
10:
END;
{103}
PROCEDURE Sendtheoutpu;
LABEL
2,21,22;
VAR
curchar:eightbits;
k:0..linelength;
j:0..maxbytes;
n:integer;
BEGIN
WHILE stackptr>0 DO
BEGIN
curchar:=Getoutput;
21:
CASE curchar OF
0:;
{106}65,66,67,68,69,70,71,72,73,74,75,
76,77,78,79,80,81,82,83,84,85,86,
87,88,89,90:
BEGIN
outcontrib[1]:=curchar;
Sendout(2,1);
END;
97,98,99,100,101,102,103,104,105,106,
107,108,109,110,111,112,113,114,115
,116,117,118,119,120,121,122:BEGIN
outcontrib[1]:=curchar-32;
Sendout(2,1);
END;
130:BEGIN
k:=0;
j:=bytestart[curval];
WHILE(k<maxidlength)AND(j<bytestart[curval+1])DO
BEGIN
k:=k+1;
outcontrib[k]:=bytemem[j];
j:=j+1;
IF outcontrib[k]>=97 THEN
outcontrib[k]:=outcontrib[k]-32
ELSE
IF
outcontrib[k]=95 THEN
k:=k-1;
END;
Sendout(2,k);
END;
{108}48,49,50,51,52,53,54,55,56,57:BEGIN
n:=0;
REPEAT
IF n>=214748364 THEN
BEGIN
Writeln(tty);
Write(tty,'! Constant too big');
Error;
END
ELSE
n:=10*n+curchar-48;
curchar:=Getoutput;
UNTIL(curchar>57)OR(curchar<48);
Sendval(n);
k:=0;
IF curchar=101 THEN
curchar:=69;
IF curchar=69 THEN
GOTO 2
ELSE
GOTO 21;
END;
12:BEGIN
n:=0;
curchar:=48;
REPEAT
IF n>=268435456 THEN
BEGIN
Writeln(tty);
Write(tty,'! Constant too big');
Error;
END
ELSE
n:=8*n+curchar-48;
curchar:=Getoutput;
UNTIL(curchar>55)OR(curchar<48);
Sendval(n);
GOTO 21;
END;
128:Sendval(curval);
46:BEGIN
k:=1;
outcontrib[1]:=46;
curchar:=Getoutput;
IF curchar=46 THEN
BEGIN
outcontrib[2]:=46;
Sendout(1,2);
END
ELSE
IF(curchar>=48)AND(curchar<=57)THEN
GOTO 2
ELSE
BEGIN
Sendout(0
,46);
GOTO 21;
END;
END;
43,45:Sendsign(44-curchar);
{104}4:BEGIN
outcontrib[1]:=65;
outcontrib[2]:=78;
outcontrib[3]:=68;
Sendout(2,3);
END;
5:BEGIN
outcontrib[1]:=78;
outcontrib[2]:=79;
outcontrib[3]:=84;
Sendout(2,3);
END;
6:BEGIN
outcontrib[1]:=73;
outcontrib[2]:=78;
Sendout(2,2);
END;
31:BEGIN
outcontrib[1]:=79;
outcontrib[2]:=82;
Sendout(2,2);
END;
24:BEGIN
outcontrib[1]:=58;
outcontrib[2]:=61;
Sendout(1,2);
END;
26:BEGIN
outcontrib[1]:=60;
outcontrib[2]:=62;
Sendout(1,2);
END;
28:BEGIN
outcontrib[1]:=60;
outcontrib[2]:=61;
Sendout(1,2);
END;
29:BEGIN
outcontrib[1]:=62;
outcontrib[2]:=61;
Sendout(1,2);
END;
30:BEGIN
outcontrib[1]:=61;
outcontrib[2]:=61;
Sendout(1,2);
END;
32:BEGIN
outcontrib[1]:=46;
outcontrib[2]:=46;
Sendout(1,2);
END;
39:{107}BEGIN
k:=1;
outcontrib[1]:=39;
REPEAT
IF k<linelength THEN
k:=k+1;
outcontrib[k]:=Getoutput;
UNTIL(outcontrib[k]=39)OR(stackptr=0);
IF k=linelength THEN
BEGIN
Writeln(tty);
Write(tty,'! String too long');
Error;
END;
Sendout(1,k);
curchar:=Getoutput;
IF curchar=39 THEN
outstate:=6;
GOTO 21;
END;
{105}33,34,35,36,37,38,40,41,42,44,47,58,59,60,61,62,63,64,91,92,93,94,
95,96,123,124,125:Sendout(0,curchar);
{110}9:BEGIN
IF bracelevel=0 THEN
Sendout(0,123)
ELSE
Sendout(0,91);
bracelevel:=bracelevel+1;
END;
10:IF bracelevel>0 THEN
BEGIN
bracelevel:=bracelevel-1;
IF bracelevel=0 THEN
Sendout(0,125)
ELSE
Sendout(0,93);
END
ELSE
BEGIN
Writeln(tty);
Write(tty,'! Extra @}');
Error;
END;
129:IF bracelevel=0 THEN
BEGIN
Sendout(0,123);
Sendval(curval);
Sendout(0,125);
END
ELSE
BEGIN
Sendout(0,91);
Sendval(curval);
Sendout(0,93);
END;
127:BEGIN
Sendout(3,0);
outstate:=6;
END;
OTHERS:BEGIN
Writeln(tty);
Write(tty,'! Can''t output ascii code ',curchar:0);
Error;
END
END;
GOTO 22;
2:{109}
REPEAT
IF k<linelength THEN
k:=k+1;
outcontrib[k]:=curchar;
curchar:=Getoutput;
IF(outcontrib[k]=69)AND((curchar=43)OR(curchar=45))THEN
BEGIN
IF k<
linelength THEN
k:=k+1;
outcontrib[k]:=curchar;
curchar:=Getoutput;
END
ELSE
IF curchar=101 THEN
curchar:=69;
UNTIL(curchar<>69)AND((curchar<48)OR(curchar>57));
IF k=linelength THEN
BEGIN
Writeln(tty);
Write(tty,'! Fraction too long');
Error;
END;
Sendout(3,k);
GOTO 21;
22:
END;
END;
{114}PROCEDURE Getline;
BEGIN
IF buffer[0]=12 THEN
line:=0;
IF Inputln THEN
BEGIN
IF line=0 THEN
BEGIN
page:=page+1;
{115}{IF(PAGE=1)AND(LIMIT=29)THEN IF(BUFFER[0]=67)AND(BUFFER[8]=22)THEN
REPEAT IF INPUTLN THEN ELSE BEGIN LIMIT:=0;BUFFER[0]:=12;END;
UNTIL BUFFER[0]=12};
END;
IF buffer[limit]=13 THEN
buffer[limit]:=32;
END
ELSE
IF buffer[0]<>12 THEN
BEGIN
limit:=0;
buffer[0]:=12;
END
ELSE
inputhasende:=true;
line:=line+1;
loc:=0;
END;
{116}
FUNCTION Controlcode(c:asciicode):eightbits;
BEGIN
CASE c OF
64:Controlcode:=64;
39:Controlcode:=12;
32,9:Controlcode:=137;
42:BEGIN
Write(tty,'*');
Controlcode:=137;
END;
68,100:Controlcode:=133;
70,102:Controlcode:=132;
123:Controlcode:=9;
125:Controlcode:=10;
80,112:Controlcode:=134;
84,116,94,46,58:Controlcode:=131;
38:Controlcode:=127;
60:Controlcode:=135;
OTHERS:Controlcode:=0
END;
END;
{117}
FUNCTION Skipahead:eightbits;
LABEL
30;
VAR
c:eightbits;
BEGIN
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
loc:=1;
c:=136;
GOTO 30;
END;
END;
buffer[limit+1]:=64;
WHILE buffer[loc]<>64 DO loc:=loc+1;
IF loc<=limit THEN
BEGIN
loc:=loc+2;
c:=Controlcode(buffer[loc-1]);
IF(c<>0)OR(buffer[loc-1]=62)THEN
GOTO 30;
END;
END;
30:
Skipahead:=c;
END;
{118}
PROCEDURE Skipcomment;
LABEL
10;
VAR
bal:eightbits;
c:asciicode;
BEGIN
bal:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in mid-comment');
Error;
END;
loc:=1;
GOTO 10;
END;
END;
c:=buffer[loc];
loc:=loc+1;
{119}
IF c=64 THEN
BEGIN
c:=buffer[loc];
IF(c<>32)AND(c<>9)AND(c<>42)THEN
loc:=loc+1
ELSE
BEGIN
BEGIN
Writeln(tty
);
Write(tty,'! Module ended in mid-comment');
Error;
END;
loc:=loc-1;
GOTO 10;
END
END
ELSE
IF(c=92)AND(buffer[loc]<>64)THEN
loc:=loc+1
ELSE
IF c=123
THEN
bal:=bal+1
ELSE
IF c=125 THEN
BEGIN
IF bal=0 THEN
GOTO 10;
bal:=bal-1;
END;
END;
10:
END;
{121}
FUNCTION Getnext:eightbits;
LABEL
20,30;
VAR
c:eightbits;
d:eightbits;
j,k:0..longestname;
BEGIN
20:
IF loc>limit THEN
Getline;
c:=buffer[loc];
loc:=loc+1;
CASE c OF
65,66,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85
,86,87,88,89,90,97,98,99,100,101,102,103,104,105,106,107,108,109,110,111
,112,113,114,115,116,117,118,119,120,121,122:{123}BEGIN
IF((c=101)OR(c=
69))AND(loc>1)THEN
IF(buffer[loc-2]<=57)AND(buffer[loc-2]>=48)THEN
c:=0;
IF c<>0 THEN
BEGIN
loc:=loc-1;
idfirst:=loc;
REPEAT
loc:=loc+1;
d:=buffer[loc];
UNTIL((d<48)OR((d>57)AND(d<65))OR((d>90)AND(d<97))OR(d>122))AND(d<>95);
IF loc>idfirst+1 THEN
BEGIN
c:=130;
idloc:=loc;
END;
END
ELSE
c:=69;
END;
34:{124}BEGIN
doublechars:=0;
idfirst:=loc-1;
REPEAT
d:=buffer[loc];
loc:=loc+1;
IF(d=34)OR(d=64)THEN
IF buffer[loc]=d THEN
BEGIN
loc:=loc+1;
d:=0;
doublechars:=doublechars+1;
END
ELSE
BEGIN
IF d=64 THEN
BEGIN
Writeln(tty);
Write(tty,'! Double @ sign missing');
Error;
END
END
ELSE
IF loc>limit THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! String constant didn''t end');
Error;
END;
d:=34;
END;
UNTIL d=34;
idloc:=loc-1;
c:=130;
END;
64:{125}BEGIN
c:=Controlcode(buffer[loc]);
loc:=loc+1;
IF c=0 THEN
GOTO 20
ELSE
IF c=135 THEN
{126}
BEGIN{128}
k:=0;
WHILE true DO
BEGIN
IF loc>limit THEN
BEGIN
Getline;
IF buffer[0]=12 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Page ended in module name');
Error;
END;
loc:=1;
GOTO 30;
END;
END;
d:=buffer[loc];
{129}
IF d=64 THEN
BEGIN
d:=buffer[loc+1];
IF d=62 THEN
BEGIN
loc:=loc+2;
GOTO 30;
END;
IF(d=32)OR(d=9)OR(d=42)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module name didn''t end');
Error;
END;
GOTO 30;
END;
k:=k+1;
module[k]:=64;
loc:=loc+1;
END;
loc:=loc+1;
IF k<longestname-1 THEN
k:=k+1;
IF(d=32)OR(d=9)THEN
BEGIN
d:=32;
IF module[k-1]=32 THEN
k:=k-1;
END;
module[k]:=d;
END;
30:{130}
IF k>=longestname-2 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Module name too long: ');
END;
FOR j:=1 TO 25 DO Write(tty,xchr[module[j]]);
Write(tty,'...');
END;
IF(module[k]=32)AND(k>0)THEN
k:=k-1;
;
IF k>3 THEN
BEGIN
IF(module[k]=46)AND(module[k-1]=46)AND(module[k-2]=46)
THEN
curmodule:=Prefixlookup(k-3)
ELSE
curmodule:=Modlookup(k);
END
ELSE
curmodule:=Modlookup(k);
END
ELSE
IF c=131 THEN
BEGIN
REPEAT
c:=Skipahead;
UNTIL c<>64;
IF buffer[loc-1]<>62 THEN
BEGIN
Writeln(tty);
Write(tty,'! Improper @ within control text');
Error;
END;
GOTO 20;
END;
END;
{122}46:IF buffer[loc]=46 THEN
BEGIN
c:=32;
loc:=loc+1;
END
ELSE
IF buffer[loc]=41 THEN
BEGIN
c:=93;
loc:=loc+1;
END;
58:IF buffer[loc]=61 THEN
BEGIN
c:=24;
loc:=loc+1;
END;
61:IF buffer[loc]=61 THEN
BEGIN
c:=30;
loc:=loc+1;
END;
62:IF buffer[loc]=61 THEN
BEGIN
c:=29;
loc:=loc+1;
END;
60:IF buffer[loc]=61 THEN
BEGIN
c:=28;
loc:=loc+1;
END
ELSE
IF buffer[loc]=62 THEN
BEGIN
c:=26;
loc:=loc+1;
END;
40:IF buffer[loc]=42 THEN
BEGIN
c:=9;
loc:=loc+1;
END
ELSE
IF buffer[loc]=46 THEN
BEGIN
c:=91;
loc:=loc+1;
END;
42:IF buffer[loc]=41 THEN
BEGIN
c:=10;
loc:=loc+1;
END;
32,9:GOTO 20;
123:BEGIN
Skipcomment;
GOTO 20;
END;
12:c:=136;
OTHERS:
END;
{IF TROUBLESHOOT THEN DEBUGHELP;}Getnext:=c;
END;
{132}
PROCEDURE Scannumeric(p:namepointer);
LABEL
21,30;
VAR
accumulator:integer;
nextsign:-1..+1;
q:namepointer;
val:integer;
PROCEDURE Addin(v:integer);
BEGIN
accumulator:=accumulator+nextsign*v;
nextsign:=+1;
END;
BEGIN{133}
accumulator:=0;
nextsign:=+1;
WHILE true DO
BEGIN
nextcontrol:=Getnext;
21:
CASE nextcontrol OF
48,49,50,51,52,53,54,55,56,57:BEGIN{135}
val:=0;
REPEAT
val:=10*val+nextcontrol-48;
nextcontrol:=Getnext;
UNTIL(nextcontrol>57)OR(nextcontrol<48);
;
Addin(val);
GOTO 21;
END;
12:BEGIN{136}
val:=0;
nextcontrol:=48;
REPEAT
val:=8*val+nextcontrol-48;
nextcontrol:=Getnext;
UNTIL(nextcontrol>55)OR(nextcontrol<48);
;
Addin(val);
GOTO 21;
END;
130:BEGIN
q:=Idlookup(0);
IF ilk[q]<>1 THEN
BEGIN
nextcontrol:=42;
GOTO 21;
END;
Addin(equiv[q]-32768);
END;
43:;
45:nextsign:=-nextsign;
132,133,135,134,136,137:GOTO 30;
59:BEGIN
Writeln(tty);
Write(tty,'! Omit semicolon in numeric definition');
Error;
END;
OTHERS:{134}BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Improper numeric definition will be flushed');
Error;
END;
REPEAT
nextcontrol:=Skipahead
UNTIL(nextcontrol>=132);
IF nextcontrol=135 THEN
BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
END;
accumulator:=0;
GOTO 30;
END
END;
END;
30:;
IF Abs(accumulator)>=32768 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Value too big: ',accumulator:0);
Error;
END;
accumulator:=0;
END;
equiv[p]:=accumulator+32768;
END;
{139}PROCEDURE Scanrepl(t:eightbits);
LABEL
22,30,31;
VAR
a:sixteenbits;
b:asciicode;
bal:eightbits;
BEGIN
bal:=0;
WHILE true DO
BEGIN
22:
a:=Getnext;
CASE a OF
40:bal:=bal+1;
41:IF bal=0 THEN
BEGIN
Writeln(tty);
Write(tty,'! Extra )');
Error;
END
ELSE
bal:=bal-1;
39:{142}BEGIN
b:=39;
WHILE true DO
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=b;
tokptr:=tokptr+1;
END;
IF b=64 THEN
IF buffer[loc]=64 THEN
loc:=loc+1
ELSE
BEGIN
Writeln(tty);
Write(tty,'! You should double @ signs in strings');
Error;
END;
IF loc=limit THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! String didn''t end');
Error;
END;
buffer[loc]:=39;
buffer[loc+1]:=0;
END;
b:=buffer[loc];
loc:=loc+1;
IF b=39 THEN
BEGIN
IF buffer[loc]<>39 THEN
GOTO 31
ELSE
BEGIN
loc:=loc+1
;
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=39;
tokptr:=tokptr+1;
END;
END;
END;
END;
31:
END;
35:IF t=3 THEN
a:=13;
{141}130:BEGIN
a:=Idlookup(0);
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=(a DIV 256)+128;
tokptr:=tokptr+1;
END;
a:=a MOD 256;
END;
135:IF t<>135 THEN
GOTO 30
ELSE
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=(curmodule DIV 256)+168;
tokptr:=tokptr+1;
END;
a:=curmodule MOD 256;
END;
133,132,134:IF t<>135 THEN
GOTO 30
ELSE
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! @',xchr[buffer[loc-1]],' is ignored in PASCAL text');
Error;
END;
GOTO 22;
END;
136,137:GOTO 30;
OTHERS:
END;
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=a;
tokptr:=tokptr+1;
END;
END;
30:
nextcontrol:=a;
{140}
IF bal>0 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Missing ',bal:0,' )');
Error;
END;
WHILE bal>0 DO
BEGIN
BEGIN
IF tokptr=maxtoks THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','token',' capacity exceeded');
Error;
Quit;
END;
tokmem[tokptr]:=41;
tokptr:=tokptr+1;
END;
bal:=bal-1;
END;
END;
IF textptr=maxtexts THEN
BEGIN
Writeln(tty);
Write(tty,'! Sorry, ','text',' capacity exceeded');
Error;
Quit;
END;
currepltext:=textptr;
textptr:=textptr+1;
tokstart[textptr]:=tokptr;
END;
{143}
PROCEDURE Definemacro(t:eightbits);
VAR
p:namepointer;
BEGIN
p:=Idlookup(t);
Scanrepl(t);
equiv[p]:=currepltext;
textlink[currepltext]:=0;
END;
{145}
PROCEDURE Scanmodule;
LABEL
30,10;
VAR
p:namepointer;
BEGIN
modulecount:=modulecount+1;
{146}nextcontrol:=0;
WHILE true DO
BEGIN
22:
WHILE nextcontrol<=132 DO
BEGIN
nextcontrol:=
Skipahead;
IF nextcontrol=135 THEN
BEGIN
loc:=loc-2;
nextcontrol:=Getnext;
END;
END;
IF nextcontrol<>133 THEN
GOTO 30;
nextcontrol:=Getnext;
IF nextcontrol<>130 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Definition flushed, must start with ',
'identifier of length > 1');
Error;
END;
GOTO 22;
END;
nextcontrol:=Getnext;
IF nextcontrol=61 THEN
BEGIN
Scannumeric(Idlookup(1));
GOTO 22;
END
ELSE
IF nextcontrol=30 THEN
BEGIN
Definemacro(2);
GOTO 22;
END
ELSE
{147}
IF nextcontrol=40 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=35 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=41 THEN
BEGIN
nextcontrol:=Getnext;
IF nextcontrol=61 THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! Use == for macros');
Error;
END;
nextcontrol:=30;
END;
IF nextcontrol=30 THEN
BEGIN
Definemacro(3);
GOTO 22;
END;
END;
END;
END;
;
BEGIN
Writeln(tty);
Write(tty,'! Definition flushed since it starts badly');
Error;
END;
END;
30:;
{148}
CASE nextcontrol OF
134:p:=0;
135:BEGIN
p:=curmodule;
{149}
REPEAT
nextcontrol:=Getnext;
UNTIL nextcontrol<>43;
IF(nextcontrol<>61)AND(nextcontrol<>30)THEN
BEGIN
BEGIN
Writeln(tty);
Write(tty,'! PASCAL text flushed, = sign is missing');
Error;
END;
REPEAT
nextcontrol:=Skipahead;
UNTIL nextcontrol>=136;
GOTO 10;
END;
END;
OTHERS:GOTO 10
END;
{150}Storetwobyte(53248+modulecount);
;
Scanrepl(135);
{151}
IF p=0 THEN
BEGIN
textlink[lastunnamed]:=currepltext;
lastunnamed:=currepltext;
END
ELSE
IF equiv[p]=0 THEN
equiv[p]:=currepltext
ELSE
BEGIN
p:=equiv[p]
;
WHILE textlink[p]<maxtexts DO p:=textlink[p];
textlink[p]:=currepltext;
END;
textlink[currepltext]:=maxtexts;
;
;
10:
END;
{154}{PROCEDURE DEBUGHELP;
LABEL 888,10;
VAR K:SIXTEENBITS;
BEGIN
DEBUGSKIPPED:=DEBUGSKIPPED+1;
IF DEBUGSKIPPED<DEBUGCYCLE THEN GOTO 10;
DEBUGSKIPPED:=0;
888:['*************breakpoint*************';
'***********for**debugging***********']
WHILE TRUE DO
BEGIN
WRITE(TTY,'#');
READ(TTY,DDT);
IF DDT<0 THEN GOTO 10
ELSE IF DDT=0 THEN GOTO 888;
READ(TTY,DD);
CASE DDT OF
1:PRINTID(DD);
2:PRINTREPL(DD);
3:FOR K:=1 TO DD DO WRITE(TTY,XCHR[BUFFER[K]]);
4:FOR K:=1 TO DD DO WRITE(TTY,XCHR[MODULE[K]]);
5:FOR K:=1 TO OUTPTR DO WRITE(TTY,XCHR[OUTBUF[K]]);
6:FOR K:=1 TO DD DO WRITE(TTY,XCHR[OUTCONTRIB[K]]);
OTHERS:WRITE(TTY,'?')
END;
END;
10:END;}
{155}BEGIN
Initialize;
{113}Openinput;
page:=0;
line:=0;
limit:=0;
loc:=1;
buffer[0]:=32;
inputhasende:=false;
;
{156}phaseone:=true;
modulecount:=0;
REPEAT
nextcontrol:=Skipahead;
WHILE nextcontrol=137 DO Scanmodule;
UNTIL inputhasende;
phaseone:=false;
{MAXTOKPTR:=TOKPTR;}
{102}
IF textlink[0]=0 THEN
BEGIN
Writeln(tty);
Write(tty,'! No output was specified.');
END
ELSE
BEGIN
BEGIN
Writeln(tty);
Write(tty,'Writing the output file...');
END;
{73}stackptr:=1;
bracelevel:=0;
curstate.namefield:=0;
curstate.replfield:=textlink[0];
curstate.bytefield:=tokstart[curstate.replfield];
curstate.endfield:=tokstart[curstate.replfield+1];
{86}outstate:=0;
outptr:=0;
breakptr:=0;
semiptr:=0;
outbuf[0]:=0;
line:=1;
Sendtheoutpu;
{88}
IF(outstate<>0)OR(outbuf[breakptr]<>46)THEN
BEGIN
Writeln(tty);
Write(tty,'! Program didn''t end with period');
Error;
END;
breakptr:=outptr;
semiptr:=0;
Flushbuffer;
;
BEGIN
Writeln(tty);
Write(tty,'Done.');
END;
END;
9999:
IF stringptr>128 THEN
BEGIN
Writeln(tty);
Write(tty,stringptr-128:0,' strings written to string pool file.');
END;
{[157]
BEGIN
WRITELN(TTY);
WRITE(TTY,'Memory usage statistics:');
END;
BEGIN
WRITELN(TTY);
WRITE(TTY,NAMEPTR:0,' names, ',TEXTPTR:0,' replacement texts;');
END;
BEGIN
WRITELN(TTY);
WRITE(TTY,BYTEPTR:0,' bytes, ',MAXTOKPTR:0,' tokens.');
END;;}
END.